home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 October / macformat-005.iso / Shareware City / Developers / xlispmac / INIT.LSP next >
Encoding:
Lisp/Scheme  |  1994-05-28  |  3.4 KB  |  112 lines  |  [TEXT/xlsp]
  1. ; initialization file for XLISP-PLUS 2.1g
  2.  
  3. (princ "XLISP-PLUS 2.1g contains contributed code by:
  4. Tom Almy, Mikael Pettersson, Neal Holtz, Johnny Greenblatt, Ken Whedbee,
  5. Blake McBride, Pete Yadlowsky, Hume Smith, and Richard Zidlicky.
  6. Portions copyright (c) 1988, Luke Tierney.\n")
  7.  
  8. ;; Set this up however you want it
  9. (setq *features* (list :xlisp :21g))
  10.  
  11. ;; Differences in various implementations, needed by example programs
  12. (when (fboundp 'export)
  13.       (setq *features* (cons :packages *features*)))
  14. #+:packages
  15. (in-package "XLISP")
  16. (when (fboundp 'get-internal-run-time) 
  17.       (setq *features* (cons :times *features*)))
  18. (when (fboundp 'generic) 
  19.       (setq *features* (cons :generic *features*)))
  20. (when (fboundp 'find-if)
  21.       (setq *features* (cons :posfcns *features*)))
  22. (when (fboundp 'log)
  23.       (setq *features* (cons :math *features*)))
  24. (when (alphanumericp #\M-C-@)
  25.       (setq *features* (cons :pc8 *features*)))
  26. (when (fboundp 'values)
  27.       (setq *features* (cons :mulvals *features*)))
  28. (when (fboundp 'get-key)
  29.       (setq *features* (cons :getkey *features*)))
  30.  
  31. #+:packages  ;; These should not be exported from XLISP
  32. (unexport '(%copy-struct %struct-set %struct-ref %struct-type-p %make-struct))
  33.  
  34. #-:packages
  35. (defun export (x))    ;; dummy definitions for package functions
  36. #-:packages
  37. (defun in-package (x))
  38.  
  39. (export '(strcat set-macro-character get-macro-character savefun
  40.       debug nodebug))
  41.  
  42. (defun strcat (&rest str)    ;; Backwards compatibility
  43.        (apply #'concatenate 'string str))
  44.  
  45.  
  46. ; (set-macro-character ch fun [ tflag ])
  47. (defun set-macro-character (ch fun &optional tflag)
  48.     (setf (aref *readtable* (char-int ch))
  49.           (cons (if tflag :tmacro :nmacro) fun))
  50.     t)
  51.  
  52. ; (get-macro-character ch)
  53. (defun get-macro-character (ch)
  54.   (if (consp (aref *readtable* (char-int ch)))
  55.     (cdr (aref *readtable* (char-int ch)))
  56.     nil))
  57.  
  58. ; (savefun fun) - save a function definition to a file
  59. (defmacro savefun (fun)
  60.   `(let* ((fname (strcat (symbol-name ',fun) ".lsp"))
  61.           (fval (get-lambda-expression (symbol-function ',fun)))
  62.           (fp (open fname :direction :output)))
  63.      (cond (fp (print (cons (if (eq (car fval) 'lambda)
  64.                                 'defun
  65.                                 'defmacro)
  66.                             (cons ',fun (cdr fval))) fp)
  67.                (close fp)
  68.                fname)
  69.            (t nil))))
  70.  
  71. ; (debug) - enable debug breaks
  72. (defun debug ()
  73.        (setq *breakenable* t))
  74.  
  75. ; (nodebug) - disable debug breaks
  76. (defun nodebug ()
  77.        (setq *breakenable* nil))
  78.  
  79. ; initialize to enable breaks but no trace back
  80. (setq *breakenable* t *tracenable* nil)
  81.  
  82.  
  83. ; macros get displaced with expansion
  84. ; Good feature, but comment out to avoid shock.
  85. (setq *displace-macros* t)
  86.  
  87. ;; Select one of these three choices
  88. ;; Other modes will not read in other standard lsp files
  89.  
  90.  
  91. ; print in upper case, case insensitive input
  92. ;(setq *print-case* :upcase *readtable-case* :upcase)
  93.  
  94. ; print in lower case
  95. (setq *print-case* :downcase *readtable-case* :upcase)
  96.  
  97. ; case sensitive, lowercase and uppercase swapped (favors lower case)
  98. ;(setq *print-case* :downcase *readtable-case* :invert)
  99.  
  100. ; Make this "T" to use doskey or run under Epsilon
  101. ; Comment out altogether for non-MSDOS environments
  102. (setq *dos-input* nil)
  103.  
  104. ;; Define Class and Object to be class and object when in case sensitive
  105. ;; mode
  106.  
  107. (when (eq *readtable-case* :invert)
  108.       (defconstant Class class)
  109.       (defconstant Object object)
  110.       (export '(Class Object)))
  111.  
  112.